home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 18 / fpc103.zip / STATUS.SEQ < prev    next >
Text File  |  1988-06-23  |  2KB  |  45 lines

  1. \ STATUS.SEQ    Display a status line at screen top.    by Tom Zimmer
  2.  
  3. : <.STAT>       ( --- )
  4.                 #OUT @ #LINE @ >R >R
  5.                 ATTRIB C@ >R
  6.                 BASE @ >R DECIMAL
  7.                 0 0 AT >ATTRIB1
  8.                 ." C - " SP@ HERE - 0 1000 um/mod nip (U.) TYPE ." k : - "
  9.                 #LISTSEGS XHERE DROP XSEG @ - - 16 *D
  10.                 1000 um/mod nip (U.) TYPE ." k"
  11.                 2 spaces DEPTH
  12.                 IF      >ATTRIB4 ."  Depth " DEPTH (U.) DUP >R TYPE
  13.                         4 R> - SPACES >ATTRIB1
  14.                 ELSE    ." Stack Empty"
  15.                 THEN    2 spaces SHNDL @ >HNDLE @ -1 =
  16.                 IF      shndl @ dup clr-hcb pathset drop
  17.                         -2 shndl @ >hndle !
  18.                 THEN    .SHNDL 80 #OUT @ DUP >R - 0 MAX SPACES
  19.                 R> 57 <
  20.                 IF      57 0 AT
  21.                         CONTEXT @ BODY> >NAME .ID BL FEMIT
  22.                         CURRENT @ BODY> >NAME .ID
  23.                 THEN    74 0 AT BL FEMIT
  24.                         GETTIME <.HM> DROP >NORM
  25.                         R> BASE ! R> ATTRIB C! R> R> AT ;
  26.  
  27. : .STATUS       ( -- )
  28.                 DEFERS STATUS
  29.                 ?STACK
  30.                 STATV @
  31.                 IF      <.STAT>
  32.                 THEN    ;
  33.  
  34. ' .STATUS IS STATUS             \ Status printed for command lines.
  35. ' <.STAT> IS LOADSTAT           \ Status printed while loading.
  36.  
  37. : STATON        ( --- )
  38.                 STATV ON ;
  39.  
  40. : STATOFF       ( --- )
  41.                 STATV OFF ;
  42.  
  43. STATON          \ DEFAULT TO DISPLAYING STATUS LINE.
  44.  
  45.